Il Mio Computer 2006 May

home *** CD-ROM | disk | FTP | other *** search

/ Il Mio Computer 2006 May / Mico05CD.bin / Internet / VisualIRC / virc200.exe / {app} / Scripts / schat.vsc < prev next >

Wrap

Text File | 2003-05-16 | 40.6 KB | 1,262 lines

// SimpleChat client/server for ViRC 2.0pre8 and above // Copyright 2001 Jesse McGrew (Mr2001) - u7hycyct02@sneakemail.com // Message Of The Day (MOTD) - this will be sent to clients who connect to // any SimpleChat sessions that you are hosting. @ $SChatMOTD = SimpleChat hosted by ViRC $ver // Default password mode: // 0 - no password required // 1 - master password (same for each connection) // 2 - individual passwords // you can change the password mode of an individual server with /pmode. @ $SChatPasswordMode = 2 // Debug mode - if enabled (1), you will see green network debug messages. @ $SChatDebugMode = 0 //------------------------------------------------------------------------- // Version check if ($build < 200) || ($build == 200 && $prebuild > 0 && $prebuild < 11) MessageBox This script requires ViRC 2.0pre11. Please download it from http://www.hansprestige.com/virc/beta.php Halt endif //------------------------------------------------------------------------- // General SimpleChat window class Class TSimpleChatForm // public Property Nick Property Caption read GetRelay write SetRelay Property TabCaption read GetRelay write SetRelay Property Visible read GetRelay write SetRelay Property Whiteboard // Method TextOut TextOut > %$prop($Self.Output) $1- EndMethod // Method Clear Clear %$prop($Self.Output) EndMethod // Method Debug if ($SChatDebugMode) $Self.TextOut clGreen $1- endif EndMethod // // private/protected Private Property Form Private Property Input Protected Property List Private Property Output Protected Property Socket // Private Method <Create> @ $SChatForms = $listcat($SChatForms $Self) @l $form = $new(TTabbedForm $1-) @p $Self.Form = $form if ($fileexists(schat.ico)) $form.Icon.LoadFromFile schat.ico endif @p $form.Tag = $Self @p $form.FormStyle = fsMDIChild @p $form.Width = 541 @p $form.Height = 339 @p $form.OnClose = $Self.FormClosed @l $socket = $new(TSockets) @p $Self.Socket = $socket @p $socket.OnStateChanged = $Self.SocketStateChanged @l $input = $new(TInputMemo ownedby $form) @p $Self.Input = $input @p $input.Height = 24 @p $input.Align = alBottom @p $input.OnKeyDown = $Self.InputKeyDown @p $input.Font.Name = $getsetting(Fonts MainName) @p $input.Font.Size = $getsetting(Fonts MainSize) @l $list = $new(TListBox ownedby $form) @p $Self.List = $list @p $list.Width = 105 @p $list.Align = alRight @p $list.Sorted = True @p $list.Font.Name = $getsetting(Fonts NickListName) @p $list.Font.Size = $getsetting(Fonts NickListSize) @p $list.OnDblClick = $Self.ListDblClick @l $output = $new(TMonkeySex ownedby $form) @p $Self.Output = $output @p $output.Align = alClient @p $output.Font.Name = $getsetting(Fonts MainName) @p $output.Font.Size = $getsetting(Fonts MainSize) @p $output.OnCopyText = $Self.OutputCopyText @p $output.OnHyperlink = $Self.OutputHyperlink EndMethod Private Method <Destroy> SafeDestroy $prop($Self.Socket) SafeDestroy $prop($Self.Form) @ $SChatForms = $listremove($Self $SChatForms) EndMethod Private Method SetRelay @p $prop($Self.Form).$1 = $2- EndMethod Private Method GetRelay @ $fresult = $prop($prop($Self.Form).$1) EndMethod Method SocketStateChanged $Self.Debug <state changed: $State> EndMethod Method InputKeyDown @l $input = $prop($Self.Input) switch $Key case 27: // escape $input.Lines.Clear @l $Key = 0 case 13: // process commands from the input box // the Cmd* methods are defined in the child classes @l $count = $prop($input.Lines.Count) for (@l $i = 0; $i < $count; $i++) @l $line = $input.Lines.GetString($i) continue if [$line] == [] if ([$substr($line 1 1)] == [/]) Parse $line switch $0 case /say: $Self.CmdSay $1- case /me: $Self.CmdMe $1- case /kick: $Self.CmdKick $1- case /ban: $Self.CmdBan $1- case /nick: $Self.CmdNick $1- case /quit: $Self.CmdQuit $1- case /list: $Self.CmdList case multi /raw,/quote $Self.CmdQuote $1- case /wb: $Self.CmdWB case /bans: $Self.CmdBans case /unban: $Self.CmdUnban $1- case /invite: $Self.CmdInvite $1- case /pmode: $Self.CmdPMode $1- case multi /help,/? $Self.TextOut ecError *** SimpleChat commands: /say, /me, /kick, /ban, /nick, /quit, /list, /quote, /wb, /bans, /unban, /invite, /pmode case else // run as a regular ViRC command $line endswitch EndParse else $Self.CmdSay $line endif endfor $input.Lines.Clear @l $Key = 0 endswitch EndMethod Method OutputCopyText SetClipboard $stripattrs($Text) EndMethod Method OutputHyperlink WebHyperlink $Text EndMethod Method FormClosed // close all connections @l $socket = $prop($Self.Socket) foreach ($i; $prop($Self.Users)) if ($listindex(0 $i) != 0) $socket.SetActiveConnection $listindex(0 $i) $socket.SClose endif endforeach // destroy form SafeDestroy $Self EndMethod Method ListDblClick @l $list = $prop($Self.List) @l $idx = $prop($list.ItemIndex) if ($idx != -1) $Self.TextOut ecScript *** $list.Items.GetString($idx) endif EndMethod // Protected Method HandleInfo // HandleInfo INFO |cmd nick text @l $cmd = $substr($2 2 9999) switch $cmd case WBOARD: @l $wb = $prop($Self.Whiteboard) if ([$wb] == []) // create whiteboard @l $form = $prop($Self.Form) @l $wb = $newwhiteboard(SimpleChat: $prop($form.TabCaption)) @p $Self.Whiteboard = $wb endif Whiteboard $wb simulate $4- case MOTD: $Self.TextOut ecNotice *** \b$4-\b endswitch EndMethod // Method CmdWB @l $wb = $prop($Self.Whiteboard) if ([$wb] == []) // create whiteboard @l $form = $prop($Self.Form) @l $wb = $newwhiteboard(SimpleChat: $prop($form.TabCaption)) @p $Self.Whiteboard = $wb endif // show whiteboard form @l $obj = $mapobject($wb) $obj.BringToFront $obj.SetFocus UnmapObject $obj EndMethod EndClass // client form Class TSimpleChatClient extends TSimpleChatForm // public Property Connected nowrite Property Registered nowrite Method PutServ @l $socket = $prop($Self.Socket) $socket.SendCRLF $1- EndMethod Method Connect @l $socket = $prop($Self.Socket) @p $socket.IPAddr = $1 @p $socket.Port = $2 @p $Self.Password = $3 $Self.TextOut ecNotice *** Connecting to $1:$2... $socket.SConnect EndMethod // // private Private Property Password Private Property Buffer Private Property GettingList Private Property TryingNick // Private Method <Create> Inherited <Create> $1- @l $socket = $prop($Self.Socket) @p $socket.OnErrorOccurred = $Self.SocketErrorOccurred @p $socket.OnSessionConnected = $Self.SocketSessionConnected @p $socket.OnSessionClosed = $Self.SocketSessionClosed @p $socket.OnDataAvailable = $Self.SocketDataAvailable @p $Self.Connected = 0 @p $Self.Registered = 0 @p $Self.GettingList = 0 @p $Self.TryingNick = 0 EndMethod Private Method <Destroy> if ($prop($Self.Connected)) @l $socket = $prop($Self.Socket) $socket.SClose endif Inherited <Destroy> $1- EndMethod Method SocketErrorOccurred $Self.TextOut ecError *** Socket error $Error ($Msg) switch $Error case multi 0,10053,10054,10060,11001 $Sender.SClose @p $Self.Connected = 0 endswitch EndMethod Method SocketSessionConnected $Self.Debug <session connected> @p $Self.Connected = 1 @l $pass = $prop($Self.Password) if ([$pass] == []) $Self.PutServ NICK |$prop($Self.Nick) else $Self.PutServ NICK |$prop($Self.Nick) $pass endif EndMethod Method SocketSessionClosed $Self.TextOut ecNotice *** Connection closed by remote host // update tab caption @l $form = $prop($Self.Form) @p $form.TabCaption = disconnected EndMethod Method SocketDataAvailable $Self.Debug <data available> @l $buffer = $prop($Self.Buffer)$prop($Sender.Text) @l $idx = $strpos($char(10) $buffer) while ($idx != 0) // extract a line @l $line = $substr($buffer 1 $($idx - 1)) if ([$substr($line $length($line) 1)] == [$char(13)]) @l $line = $substr($line 1 $($length($line) - 1)) endif $Self.Debug <line: $line> @l $buffer = $substr($buffer $($idx + 1) $length($buffer)) switch $line case LIST |START: @l $list = $prop($Self.List) $list.Items.Clear $list.Items.Add $prop($Self.Nick) (me) @p $Self.GettingList = 1 case LIST |END: @p $Self.GettingList = 0 case matches JOIN |* Parse $strtokr(| $line) $Self.TextOut ecJoin *** \b$0\b ($1) has joined the chat @l $list = $prop($Self.List) $list.Items.Add $0 ($1) EndParse case matches KICK |* Parse $strtokr(| $line) $Self.TextOut ecKick *** \b$0\b was kicked [$1-] @l $list = $prop($Self.List) $list.Items.Delete $list.Items.IndexOfMask($0 *) EndParse case matches QUIT |* Parse $strtokr(| $line) $Self.TextOut ecQuit *** \b$0\b has quit the chat [$1-] @l $list = $prop($Self.List) $list.Items.Delete $list.Items.IndexOfMask($0 *) EndParse case matches BAN |* $Self.TextOut ecNotice *** \bYou have been banned\b: $strtokr(| $line) case matches NICK |* Parse $strtokr(| $line) // server sends 'NICK |mynick' when we connect @p $Self.Registered = 1 if ([$1] != []) // nick change if ([$0] == [$prop($Self.Nick)]) @p $Self.Nick = $1 endif $Self.TextOut ecNick *** \b$0\b is now known as \b$1\b @l $list = $prop($Self.List) @l $idx = $list.Items.IndexOfMask($0 *) if ($idx >= 0) @l $newnick = $1 Parse $list.Items.GetString($idx) $list.Items.SetString $idx $newnick $1- EndParse endif endif EndParse case matches ERR |* $Self.TextOut ecError *** Error: $strtokr(| $line) // nick in use while registering? try default nicks from client setup Parse $line if ([$1] == [|NICK]) && ($prop($Self.Registered) == 0) @l $num = $prop($Self.TryingNick) $num++ if ($num > $getsetting(NickCount)) // no more nicks to try @l $nick = $?="Your nickname is in use. Enter another nickname to try:" if ([$nick] == [INPUT_CANCELLED]) @l $nick = $null endif else @l $nick = $getsetting(Nick$num) while ([$nick] == [$prop($Self.Nick)]) $num++ @l $nick = $getsetting(Nick$num) endwhile @p $Self.TryingNick = $num endif if ([$nick] != []) @p $Self.Nick = $nick $Self.TextOut ecNotice *** Trying $nick... $Self.PutServ NICK |$nick $prop($Self.Password) endif endif EndParse case matches INFO |* $Self.HandleInfo $line case matches % |* //$Self.TextOut ecError *** Unknown server info event received: $strtokl(| $line) case matches % :* Parse $line $Self.TextOut ecChanText <\b$0\b>\t$strtrim($1-) EndParse case matches % >* Parse $line $Self.TextOut ecAction * \b$0\b $strtokr(> $1-) EndParse case else if ($prop($Self.GettingList)) @l $list = $prop($Self.List) Parse $line $list.Items.Add $0 ($1) EndParse else $Self.TextOut ecError *** Unknown server line received: $line endif endswitch // find next line @l $idx = $strpos($char(10) $buffer) endwhile @p $Self.Buffer = $buffer EndMethod // command handlers Method CmdSay $Self.TextOut ecMyChanText [\b$prop($Self.Nick)\b]\t$1- $Self.PutServ :$1- EndMethod Method CmdMe $Self.TextOut ecAction * \b$prop($Self.Nick)\b $1- $Self.PutServ >$1- EndMethod Method CmdKick $Self.TextOut ecError *** You are not the server EndMethod Method CmdBan $Self.TextOut ecError *** You are not the server EndMethod Method CmdUnban $Self.TextOut ecError *** You are not the server EndMethod Method CmdBans $Self.TextOut ecError *** You are not the server EndMethod Method CmdInvite $Self.TextOut ecError *** You are not the server EndMethod Method CmdPMode $Self.TextOut ecError *** You are not the server EndMethod Method CmdNick $Self.PutServ NICK |$1- EndMethod Method CmdQuit $Self.PutServ QUIT |$1- EndMethod Method CmdQuote $Self.PutServ $1- EndMethod Method CmdList $Self.PutServ LIST | EndMethod // Method SendWB $Self.PutServ INFO |WBOARD $1- EndMethod EndClass // server form Class TSimpleChatServer extends TSimpleChatForm // public Property Address nowrite Property Port nowrite // 0=no passwords, 1=serverwide password (group invitation), 2=individual passwords (personal invitation) Property PasswordMode // Method PutClient @l $socket = $prop($Self.Socket) $socket.SetActiveConnection $1 $socket.SendCRLF $2- EndMethod Method PutAll @l $socket = $prop($Self.Socket) foreach ($i; $prop($Self.Users)) if ($listindex(2 $i) == 1) $socket.SetActiveConnection $listindex(0 $i) $socket.SendCRLF $1- endif endforeach EndMethod Method PutAllBut // PutAllBut <socknum> <text> @l $socket = $prop($Self.Socket) foreach ($i; $prop($Self.Users)) if ($listindex(0 $i) != $1) && ($listindex(2 $i) == 1) $socket.SetActiveConnection $listindex(0 $i) $socket.SendCRLF $2- endif endforeach EndMethod Method Listen // grab local ip address from server socket @l $servsock = $mapobject(.:Sock) @p $Self.Address = $prop($servsock.LocalIPAddr) UnmapObject $servsock // initialize users @p $Self.Users = <0 $prop($Self.Nick) 2 $prop($Self.Address) none> // initialize list box @l $list = $prop($Self.List) $list.Items.Add $prop($Self.Nick) (me) // listen for connections @l $socket = $prop($Self.Socket) @p $Self.Port = $socket.SListenOnFreePort() $Self.TextOut ecNotice *** Listening on $prop($Self.Address):$prop($Self.Port)... EndMethod // Method GenPassword @l $passchars = ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_@!. @ $fresult = $null // pick 8 random chars for (@l $i = 1; $i <= 8; $i++) @l $char = $substr($passchars $($rand($length($passchars)) + 1) 1) @ $fresult = $fresult$char endfor @p $Self.Passwords = $listcat($prop($Self.Passwords) $fresult) EndMethod Method ClientExists // $Self.ClientExists(Mr2001) foreach ($i; $prop($Self.Users)) if ($listindex(2 $i) != 0) && ([$listindex(1 $i)] == [$1]) @ $fresult = 1 Halt endif endforeach @ $fresult = 0 EndMethod Method ValidNick @l $letter = ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz @l $digit = 0123456789 @l $special = []\`_^{|} @ $fresult = 0 // first character must be letter or special Halt if $strpos($substr($1- 1 1) $letter$special) == 0 // rest must be letter, digit, or special for (@l $i = 2; $i <= $length($1-); $i++) Halt if $strpos($substr($1- $i 1) $letter$digit$special) == 0 endfor @ $fresult = 1 EndMethod // // private // users entries: <socket> <nick> <state> <ip> <password> // <state>... 0=waiting, 1=connected, 2=local Protected Property Users Protected Property Bans Private Property Passwords Private Property Buffers // Private Method <Create> Inherited <Create> $1- @l $socket = $prop($Self.Socket) @p $socket.OnErrorOccurred = $Self.SocketErrorOccurred @p $socket.OnSessionAvailable = $Self.SocketSessionAvailable @p $socket.OnSessionClosed = $Self.SocketSessionClosed @p $socket.OnDataAvailable = $Self.SocketDataAvailable @p $Self.Users = $null @p $Self.Bans = $null @p $Self.ServerPassword = $null @p $Self.Buffers = $null @p $Self.PasswordMode = $SChatPasswordMode @p $Self.Port = 0 EndMethod Private Method <Destroy> if ($prop($Self.Port) != 0) @l $socket = $prop($Self.Socket) $socket.SCancelListen endif Inherited <Destroy> $1- EndMethod Method SocketErrorOccurred $Self.TextOut ecError *** Socket error $Error ($Msg) switch $Error case multi 0,10053,10054,10060,11001 $Sender.SClose endswitch EndMethod Method SocketSessionAvailable $Self.Debug <session available> @l $num = $Sender.SAccept() @l $idx = $listelementcount($prop($Self.Users)) @p $Self.Users = $listcat($prop($Self.Users) <$num ??? 0 $prop($Sender.RemoteIPAddr) ???>) @p $Self.Buffers = $listreplace($idx $idx "" $prop($Self.Buffers)) EndMethod Method SocketSessionClosed $Self.Debug <session closed> // find dead client's nick, build new list @l $nick = <BUG> @l $newlist = $null foreach ($i; $prop($Self.Users)) if ($listindex(0 $i) == $Socket) @l $nick = $listindex(1 $i) else @l $newlist = $listcat($newlist $listquote($i)) endif endforeach @p $Self.Users = $newlist // announce quit foreach ($i; $newlist) if ($listindex(2 $i) == 1) $Self.PutClient $listindex(0 $i) QUIT |$nick Socket closed endif endforeach // announce locally $Self.TextOut ecQuit *** \b$nick\b has left the chat [Socket closed] // and update the listbox @l $list = $prop($Self.List) @l $idx = $list.Items.IndexOfMask($nick *) if ($idx != -1) $list.Items.Delete $idx endif EndMethod Method SocketDataAvailable $Self.Debug <data available> $Sender.SetActiveConnection $Socket @l $cnum = 0 @l $buffer = $null @l $client = <BUG> @l $state = -1 @l $ip = 0.0.0.0 @l $users = $prop($Self.Users) foreach ($i; $users) if ($listindex(0 $i) == $Socket) @l $client = $listindex(1 $i) @l $state = $listindex(2 $i) @l $ip = $listindex(3 $i) @l $buffer = $listindex($cnum $prop($Self.Buffers)) Break endif $cnum++ endforeach @l $buffer = $buffer$prop($Sender.Text) @l $idx = $strpos($char(10) $buffer) while ($idx != 0) // extract a line @l $line = $substr($buffer 1 $($idx - 1)) if ([$substr($line $length($line) 1)] == [$char(13)]) @l $line = $substr($line 1 $($length($line) - 1)) endif $Self.Debug <line: $line> @l $buffer = $substr($buffer $($idx + 1) $length($buffer)) if ($state == 0) // unregistered clients can only send NICK Parse $line if ([$0] == [NICK]) // check bans and validate password if ($listindexof($ip $prop($Self.Bans)) != -1) // banned @l $valid = 0 else if ($strpos(* $2)) || ($strpos(? $2)) || ($strpos(% $2)) // no wildcard passwords, please @l $valid = 0 else switch $prop($Self.PasswordMode) case 0: // no passwords @l $valid = 1 case 1: // master password @l $valid = $($listindexof($2 $prop($Self.Passwords)) >= 0) case 2: // individual passwords // each password is removed from the list after it is validated @l $passwords = $prop($Self.Passwords) if ($listindexof($2 $passwords) >= 0) @l $valid = 1 @p $Self.Passwords = $listremove($2 $passwords) else @l $valid = 0 endif endswitch endif if !($valid) $Sender.SendCRLF ERR |NICK Access denied. $Sender.SClose // announce locally $Self.TextOut ecError *** Unauthorized connection attempt from $substr($1 2 15) ($ip) else // valid password @l $nick = $substr($1 2 15) @l $pass = $3 // make sure nick is valid and not in use if !($Self.ValidNick($nick)) $Sender.SendCRLF ERR |NICK Invalid nickname. // add password back if ($listindexof($2 $prop($Self.Passwords)) == -1) @p $Self.Passwords = $listcat($prop($Self.Passwords) $2) endif else if ($Self.ClientExists($nick)) $Sender.SendCRLF ERR |NICK Nickname in use. // add password back if ($listindexof($2 $prop($Self.Passwords)) == -1) @p $Self.Passwords = $listcat($prop($Self.Passwords) $2) endif else // acknowledge $Sender.SendCRLF NICK |$nick // send list $Sender.SendCRLF LIST |START foreach ($i; $prop($Self.Users)) if ($listindex(0 $i) != $Socket) && ($listindex(2 $i) != 0) $Sender.SendCRLF $listindex(1 $i) $listindex(3 $i) endif endforeach $Sender.SendCRLF LIST |END // update users list @l $newlist = $null foreach ($i; $prop($Self.Users)) if ($listindex(0 $i) == $Socket) // replace nick field with chosen nickname @l $newitem = $listreplace(1 1 $nick $i) // replace state with 1 @l $newitem = $listreplace(2 2 1 $newitem) // save password @l $newitem = $listreplace(4 4 $2 $newitem) else // just append the entry @l $newitem = $i // announce the join if ($listindex(2 $i) == 1) $Self.PutClient $listindex(0 $i) JOIN |$nick $ip endif endif @l $newlist = $listcat($newlist $listquote($newitem)) endforeach @p $Self.Users = $newlist // send motd $Self.PutClient $Socket INFO |MOTD $prop($Self.Nick) $SChatMOTD // display join locally $Self.TextOut ecJOIN *** \b$nick\b ($ip) has joined the chat // and add to listbox @l $list = $prop($Self.List) $list.Items.Add $nick ($ip) endif endif endif EndParse else // connected client switch $line case LIST |: $Sender.SendCRLF LIST |START foreach ($i; $prop($Self.Users)) // send this entry if it isn't the client and the state isn't 0 if ($listindex(0 $i) != $Socket) && ($listindex(2 $i) != 0) $Sender.SendCRLF $listindex(1 $i) $listindex(3 $i) endif endforeach $Sender.SendCRLF LIST |END case matches NICK |* Parse $line @l $nick = $substr($1 2 15) @l $pass = $3 // make sure nick is valid and not in use if ([$client] === [$nick]) // exactly the same nick, don't bother else if !($Self.ValidNick($nick)) $Sender.SendCRLF ERR |NICK Invalid nickname. else if ([$client] != [$nick]) && ($Self.ClientExists($nick)) $Sender.SendCRLF ERR |NICK Nickname in use. else // update users list @l $newlist = $null foreach ($i; $prop($Self.Users)) if ($listindex(0 $i) == $Socket) // replace nick field with chosen nickname @l $newlist = $listcat($newlist $listquote($listreplace(1 1 $nick $i))) else // just append the entry @l $newlist = $listcat($newlist $listquote($i)) endif // announce the nick change if ($listindex(2 $i) == 1) $Self.PutClient $listindex(0 $i) NICK |$client $nick endif endforeach @p $Self.Users = $newlist // announce nick change locally $Self.TextOut ecNick *** \b$client\b is now known as \b$nick\b // and update listbox @l $list = $prop($Self.List) @l $idx = $list.Items.IndexOfMask($client *) if ($idx >= 0) Parse $list.Items.GetString($idx) $list.Items.SetString $idx $nick $1- EndParse endif endif EndParse case matches INFO |* Parse $line if ([$1] != [|MOTD]) // relay to other clients $Self.PutAllBut $Socket INFO $1 $client $2- // process locally $Self.HandleInfo INFO $1 $client $2- endif EndParse case matches QUIT |* @l $msg = $strtokr(| $line) if ([$msg] == []) // default quit message is nick @l $msg = $client endif case matches :* // relay to other clients $Self.PutAllBut $Socket $client $line // display locally $Self.TextOut ecChanText [\b$client\b]\t$strtokr(: $line) case matches >* // relay to other clients $Self.PutAllBut $Socket $client $line // display locally $Self.TextOut ecAction * \b$client\b $strtokr(> $line) case else Parse $line $Sender.SendCRLF ERR |$upper($0) Malformed or unknown command EndParse endswitch endif // find next line @l $idx = $strpos($char(10) $buffer) endwhile @p $Self.Buffers = $listreplace($cnum $cnum $listquote($buffer) $prop($Self.Buffers)) EndMethod // command handlers Method CmdSay $Self.TextOut ecMyChanText [\b$prop($Self.Nick)\b]\t$1- $Self.PutAll $prop($Self.Nick) :$1- EndMethod Method CmdMe $Self.TextOut ecAction * \b$prop($Self.Nick)\b $1- $Self.PutAll $prop($Self.Nick) >$1- EndMethod Method CmdKick // kick <nick> [reason] if ([$2-] == []) @l $reason = $prop($Self.Nick) else @l $reason = $2- endif @l $newlist = $null foreach ($i; $prop($Self.Users)) if ([$listindex(1 $i)] == [$1]) @l $socknum = $listindex(0 $i) @l $nick = $listindex(1 $i) // notify victim $Self.PutClient $socknum QUIT |$nick $reason // notify others $Self.PutAllBut $socknum KICK |$nick $reason // save password if ($listindexof($listindex(4 $i) $prop($Self.Passwords)) == -1) @p $Self.Passwords = $listcat($prop($Self.Passwords) $listindex(4 $i)) endif // close connection @l $socket = $prop($Self.Socket) $socket.SetActiveConnection $socknum $socket.SClose // announce locally $Self.TextOut ecKick *** \b$listindex(1 $i)\b was kicked [$reason] else // add to new list @l $newlist = $listcat($newlist $listquote($i)) endif endforeach @p $Self.Users = $newlist EndMethod Method CmdBan // ban <nick> [reason] if ([$2-] == []) @l $reason = $prop($Self.Nick) else @l $reason = $2- endif @l $newlist = $null foreach ($i; $prop($Self.Users)) if ([$listindex(1 $i)] == [$1]) @l $socknum = $listindex(0 $i) @l $nick = $listindex(1 $i) // notify victim $Self.PutClient $socknum BAN |$reason // notify others $Self.PutAllBut $socknum KICK |$nick $reason (banned) // close connection @l $socket = $prop($Self.Socket) $socket.SetActiveConnection $socknum $socket.SClose // add to bans @p $Self.Bans = $listcat($prop($Self.Bans) $listindex(3 $i)) // announce locally $Self.TextOut ecKick *** \b$listindex(1 $i)\b was banned [$reason] else // add to new list @l $newlist = $listcat($newlist $listquote($i)) endif endforeach @p $Self.Users = $newlist EndMethod Method CmdUnban @l $bans = $prop($Self.Bans) if ($listindexof($1 $bans) != -1) @p $Self.Bans = $listremove($1 $Self.Bans) $Self.TextOut ecNotice *** Ban removed: $1 else $Self.TextOut ecError *** $1 is not a banned IP endif EndMethod Method CmdBans $Self.TextOut ecNotice *** Banned IPs: $prop($Self.Bans) EndMethod Method CmdInvite if ($currentserver() != 0) // generate password @l $pmode = $prop($Self.PasswordMode) if ($pmode == 0) // no password @l $pass = $null else if ($pmode == 1) // master password @l $pass = $Self.GenPassword() endif // send invitations Halt if [$1-] == [] foreach ($i; $listfromwords($1-)) $Self.TextOut clBlue *** Inviting $i... // force master passwords if inviting a channel if ($ischannel($i)) && ($pmode == 2) @l $pmode = 1 @p $Self.PasswordMode = 1 endif if ($pmode == 2) // individual passwords @l $pass = $Self.GenPassword() endif ^CTCP $i SimpleChat $encodeip($prop($Self.Address)) $prop($Self.Port) $pass endforeach else $Self.TextOut ecError *** Not associated with an IRC server endif EndMethod Method CmdPMode switch $1 case 0: @p $Self.PasswordMode = 0 $Self.TextOut ecMode *** Password mode set to 0 (no passwords) case 1: @p $Self.PasswordMode = 1 $Self.TextOut ecMode *** Password mode set to 1 (master password) case 2: @p $Self.PasswordMode = 2 $Self.TextOut ecMode *** Password mode set to 2 (individual passwords) case else $Self.TextOut ecError *** Current mode: $prop($Self.PasswordMode). Valid modes: 0 (no passwords), 1 (master password), 2 (individual passwords) EndMethod Method CmdNick // make sure nick is valid and not in use @l $curnick = $prop($Self.Nick) @l $newnick = $1 if ([$newnick] == []) Halt else if ([$newnick] === [$curnick]) // exactly the same nick, don't bother else if !($Self.ValidNick($newnick)) $Self.TextOut ecError *** Invalid nickname. else if ([$curnick] != [$newnick]) && ($Self.ClientExists($newnick)) $Self.TextOut ecError *** Nickname in use. else // change local nick @p $Self.Nick = $newnick // update users list @l $newlist = $null foreach ($i; $prop($Self.Users)) if ($listindex(0 $i) == 0) // replace nick field with chosen nickname @l $newlist = $listcat($newlist $listquote($listreplace(1 1 $newnick $i))) else // just append the entry @l $newlist = $listcat($newlist $listquote($i)) endif // announce the nick change if ($listindex(2 $i) == 1) $Self.PutClient $listindex(0 $i) NICK |$curnick $newnick endif endforeach @p $Self.Users = $newlist // announce nick change locally $Self.TextOut ecNick *** \b$curnick\b is now known as \b$newnick\b // and update listbox @l $list = $prop($Self.List) @l $idx = $list.Items.IndexOfMask($curnick *) if ($idx >= 0) Parse $list.Items.GetString($idx) $list.Items.SetString $idx $newnick $1- EndParse endif endif EndMethod Method CmdQuit if ([$1-] == []) @l $reason = server shutting down else @l $reason = server shutting down: $1- endif // disconnect clients @l $socket = $prop($Self.Socket) foreach ($i; $prop($Self.Users)) if ($listindex(0 $i) != 0) if ($listindex(2 $i) == 1) $Self.PutClient $listindex(0 $i) QUIT |$listindex(1 $i) $reason endif $socket.SetActiveConnection $listindex(0 $i) $socket.SClose endif endforeach // die SafeDestroy $Self EndMethod Method CmdQuote $Self.TextOut ecError *** You are the server EndMethod Method CmdList $Self.TextOut ecError *** You are the server EndMethod // Method SendWB $Self.PutAll INFO |WBOARD $prop($Self.Nick) $1- EndMethod EndClass // Events Event SimpleChat "% PRIVMSG % :\ASimpleChat" // CTCP SimpleChat address port password TextOut > . ecCTCP *** SimpleChat invitation from $nick ($user@$host): $decodeip($4):$5 password=$6 if ($messagedlg(36 Received SimpleChat invitation from $nick ($user@$host) on $decodeip($4):$5. Do you wish to join?) == 6) @l $schat = $new(TSimpleChatClient ownedby 0) @p $schat.Nick = $N @p $schat.Caption = SimpleChat - connected to $nick ($decodeip($4):$5) @p $schat.TabCaption = $nick $schat.Connect $decodeip($4) $5 $6 endif EndEvent Event <OnMyWhiteboardAction_schat> "*" // $0 = whiteboard name // $1- = command // look for a schat window using this whiteboard foreach ($i; $SChatForms) if ($isa($i TSimpleChatForm)) && ([$prop($i.Whiteboard)] == [$0]) // found $i.SendWB $1- Halt endif endforeach EndEvent // Aliases Alias SCHAT // start server and invite: SChat [nick1 nick2...] @l $schat = $new(TSimpleChatServer ownedby 0) @p $schat.Nick = $N @p $schat.Caption = SimpleChat - hosting @p $schat.TabCaption = [Hosting] $schat.Listen // generate password @l $pmode = $prop($schat.PasswordMode) if ($pmode == 0) // no password @l $pass = $null else if ($pmode == 1) // master password @l $pass = $schat.GenPassword() endif // send invitations Halt if [$1-] == [] foreach ($i; $listfromwords($1-)) $schat.TextOut clBlue *** Inviting $i... // force master passwords if inviting a channel if ($ischannel($i)) && ($pmode == 2) @l $pmode = 1 @p $Self.PasswordMode = 1 endif if ($pmode == 2) // individual passwords @l $pass = $schat.GenPassword() endif ^CTCP $i SimpleChat $encodeip($prop($schat.Address)) $prop($schat.Port) $pass endforeach EndAlias Alias SCC // start client: SCC <host> <port> [password] @l $schat = $new(TSimpleChatClient ownedby 0) @p $schat.Nick = $N @p $schat.Caption = SimpleChat - manual connect to $1:$2 @p $schat.TabCaption = $1:$2 $schat.Connect $1 $2 $3 EndAlias // Menus MenuTree MT_SCHAT_CHANNELNICKSPOPUP M_SCHAT <none> 0 0 &SimpleChat EndMenuTree MenuHint M_SCHAT on MT_SCHAT_CHANNELNICKSPOPUP = Invite this person to a fast private channel MenuItem M_SCHAT on MT_SCHAT_CHANNELNICKSPOPUP SChat $1- EndMenuItem #// default items # #MenuHint M_WHOIS on MT_CHANNELNICKSPOPUP = Retrieve information about the user #MenuHint M_WII on MT_CHANNELNICKSPOPUP = Retrieve information and idle time #MenuHint M_QUERY on MT_CHANNELNICKSPOPUP = Create a private message window for the user #MenuHint M_DCCCHAT on MT_CHANNELNICKSPOPUP = Secure, fast private message window #MenuHint M_DCCWBOARD on MT_CHANNELNICKSPOPUP = Shared drawing board #MenuHint M_DCCSEND on MT_CHANNELNICKSPOPUP = Send a file using the slow DCC protocol #MenuHint M_TDCCSEND on MT_CHANNELNICKSPOPUP = Send a file using Turbo DCC #MenuHint M_CTCPTIME on MT_CHANNELNICKSPOPUP = Read the user's clock #MenuHint M_CTCPVER on MT_CHANNELNICKSPOPUP = Check the user's client version #MenuHint M_CTCPPING on MT_CHANNELNICKSPOPUP = Calculate round trip time to the user #MenuHint M_OP on MT_CHANNELNICKSPOPUP = Op the user #MenuHint M_DEOP on MT_CHANNELNICKSPOPUP = Deop the user #MenuHint M_VOICE on MT_CHANNELNICKSPOPUP = Voice the user #MenuHint M_DEVOICE on MT_CHANNELNICKSPOPUP = Devoice the user #MenuHint M_KICK on MT_CHANNELNICKSPOPUP = Kick the user out of the channel #MenuHint M_KICKBAN on MT_CHANNELNICKSPOPUP = Kick and ban the user from the channel # #MenuItem <DoubleClick> on MT_CHANNELNICKSPOPUP # Whois $1 #EndMenuItem # #MenuItem M_WHOIS on MT_CHANNELNICKSPOPUP # foreach ($i; $listfromwords($1-)) # Whois $i # endforeach #EndMenuItem # #MenuItem M_WII on MT_CHANNELNICKSPOPUP # foreach ($i; $listfromwords($1-)) # Wii $i # endforeach #EndMenuItem # #MenuItem M_QUERY on MT_CHANNELNICKSPOPUP # foreach ($i; $listfromwords($1-)) # Query $i # endforeach #EndMenuItem # #MenuItem M_DCCCHAT on MT_CHANNELNICKSPOPUP # foreach ($i; $listfromwords($1-)) # DCC Chat $i # endforeach #EndMenuItem # #MenuItem M_DCCWBOARD on MT_CHANNELNICKSPOPUP # foreach ($i; $listfromwords($1-)) # DCC Whiteboard $i # endforeach #EndMenuItem # #MenuItem M_DCCSEND on MT_CHANNELNICKSPOPUP # foreach ($i; $listfromwords($1-)) # DCC Send $i # endforeach #EndMenuItem # #MenuItem M_TDCCSEND on MT_CHANNELNICKSPOPUP # foreach ($i; $listfromwords($1-)) # TDCC Send $i # endforeach #EndMenuItem # #// I would love to use a multi-variable foreach here, but some #// efnet servers don't allow /msg nick1,nick2,nick3 anymore. #MenuItem M_CTCPTIME on MT_CHANNELNICKSPOPUP # foreach ($i; $listfromwords($1-)) # CTCP $i TIME # endforeach #EndMenuItem # #MenuItem M_CTCPVER on MT_CHANNELNICKSPOPUP # foreach ($i; $listfromwords($1-)) # CTCP $i VERSION # endforeach #EndMenuItem # #MenuItem M_CTCPPING on MT_CHANNELNICKSPOPUP # foreach ($i; $listfromwords($1-)) # Ping $1 # endforeach #EndMenuItem # #MenuItem M_OP on MT_CHANNELNICKSPOPUP # foreach ($a,$b,$c,$d; $listfromwords($1-)) # Mode $C +oooo $a $b $c $d # endforeach #EndMenuItem # #MenuItem M_DEOP on MT_CHANNELNICKSPOPUP # foreach ($a,$b,$c,$d; $listfromwords($1-)) # Mode $C -oooo $a $b $c $d # endforeach #EndMenuItem # #MenuItem M_VOICE on MT_CHANNELNICKSPOPUP # foreach ($a,$b,$c,$d; $listfromwords($1-)) # Mode $C +vvvv $a $b $c $d # endforeach #EndMenuItem # #MenuItem M_DEVOICE on MT_CHANNELNICKSPOPUP # foreach ($a,$b,$c,$d; $listfromwords($1-)) # Mode $C -vvvv $a $b $c $d # endforeach #EndMenuItem # #MenuItem M_KICK on MT_CHANNELNICKSPOPUP # foreach ($i; $listfromwords($1-)) # Kick $C $i # endforeach #EndMenuItem # #MenuItem M_KICKBAN on MT_CHANNELNICKSPOPUP # foreach ($i; $listfromwords($1-)) # KB $C $i # endforeach #EndMenuItem // Initialization MergeMenu MT_SCHAT_CHANNELNICKSPOPUP after MT_CHANNELNICKSPOPUP @ $SChatForms = $null